home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / appli / graph.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-27  |  20.0 KB  |  880 lines  |  [TEXT/MPS ]
  1. #include <Events.h>
  2. #include <Fonts.h>
  3. #include <math.h>
  4. #include <Memory.h>
  5. #include <OSUtils.h>
  6. #include <QuickDraw.h>
  7. #include <Sound.h>
  8. #include "::runtime:mlvalues.h"
  9. #include "::runtime:alloc.h"
  10. #include "::runtime:memory.h"
  11. #include "::runtime:fail.h"
  12. #include "::runtime:str.h"
  13. #include "ui.h"
  14.  
  15. #define grafpk    ((graphPeek) CAMLOffScreen)
  16. #define offset_x    (grafpk->destRect.left - grafpk->viewRect.left)
  17. #define offset_y    (grafpk->destRect.top - grafpk->viewRect.top)
  18. #define Short_val(x)    ((short) Long_val(x))
  19. #define convert_y(y)    (CAMLOffScreen->portRect.bottom - 1 - Short_val(y))
  20.  
  21. #define Begin_offscreen \
  22.   { GDHandle old_device; \
  23.     if (color_qd){ \
  24.       old_device = GetGDevice (); \
  25.       SetGDevice (CAMLGDevice); \
  26.       SetPort (CAMLOffScreen); \
  27.     }
  28.     
  29. #define End_offscreen \
  30.     if (color_qd){ \
  31.       SetGDevice (old_device); \
  32.     } \
  33.   }
  34.  
  35. typedef struct graph {
  36.     GrafPort offScreen;
  37.     Rect destRect;
  38.     Rect viewRect;
  39.     Rect destRectZoom;
  40. } graphRecord, *graphPeek;
  41.  
  42. extern WindowPtr CAMLGraph;
  43. extern WindowPtr CAMLOffScreen;
  44. extern GDHandle CAMLGDevice;
  45. extern int max_depth;
  46. extern char GraphKey;
  47.  
  48. void copy_bits (const BitMap *, const BitMap *, const Rect *,
  49.                 const Rect *, short, RgnHandle);
  50. void copy_mask (const BitMap *, const BitMap *, const BitMap *,
  51.                 const Rect *, const Rect *, const Rect *);
  52. void LookGraphEvent (EventRecord *result, int move_ok, int null_ok);
  53. void LookEvent(unsigned long delay);
  54. Boolean OpenGraph(void);
  55. void DoClose(WindowPtr window);
  56. extern void enter_blocking_section (void);
  57. extern void leave_blocking_section (void);
  58.  
  59. void graphic_fail(msg)
  60.     char * msg;
  61. {
  62.     raise_with_arg(GRAPHIC_FAILURE_EXN, copy_string(msg));
  63. }
  64.  
  65. static void check_graph()
  66. {
  67.     if (CAMLGraph == nil)
  68.         graphic_fail("graphic window not opened");
  69. }
  70.  
  71. value open_graph(str)    /* ML */
  72.     value str;
  73. {
  74. #pragma unused(str)
  75.     if (CAMLGraph == nil) {
  76.         if (!OpenGraph())
  77.             graphic_fail("open_graph: cannot open graphic window");
  78.         moveto(Val_long(0), Val_long(0));
  79.     }
  80.     return Atom(0);
  81. }
  82.  
  83. value close_graph()    /* ML */
  84. {
  85.     check_graph();
  86.     DoClose(CAMLGraph);
  87.     return Atom(0);
  88. }
  89.  
  90. value clear_graph()    /* ML */
  91. {
  92.     check_graph();
  93.     SetPort(CAMLGraph);
  94.     EraseRect(&grafpk->viewRect);
  95.     Begin_offscreen
  96.           EraseRect(&CAMLOffScreen->portRect);
  97.     End_offscreen
  98.     return Atom(0);
  99. }
  100.  
  101. value size_x()    /* ML */
  102. {
  103.     Rect * r;
  104.     
  105.     check_graph();
  106.     r = &CAMLOffScreen->portRect;
  107.     return Val_long(r->right - r->left);
  108. }
  109.  
  110. value size_y()    /* ML */
  111. {
  112.     Rect * r;
  113.     
  114.     check_graph();
  115.     r = &CAMLOffScreen->portRect;
  116.     return Val_long(r->bottom - r->top);
  117. }
  118.  
  119. value set_color(color)    /* ML */
  120.     value color;
  121. {
  122.   long col = Long_val (color);
  123.   
  124.   check_graph();
  125.   if (color_qd){
  126.     RGBColor qd_col;
  127.     
  128.     qd_col.red = (col >> 16) * 257;
  129.     qd_col.green = ((col >> 8) & 0xff) * 257;
  130.     qd_col.blue = (col & 0xff) * 257;
  131.     SetPort (CAMLGraph);
  132.     RGBForeColor (&qd_col);
  133.     Begin_offscreen
  134.       RGBForeColor (&qd_col);
  135.     End_offscreen
  136.   }else{   
  137.     SetPort(CAMLGraph);
  138.     if (col == 0xffffff){
  139.       PenPat (qd.white);
  140.       TextMode (srcBic);
  141.     }else{
  142.       PenPat (qd.black);
  143.       TextMode (srcOr);
  144.     }
  145.     SetPort(CAMLOffScreen);
  146.     if (col == 0xffffff){
  147.       PenPat (qd.white);
  148.       TextMode (srcBic);
  149.     }else{
  150.       PenPat (qd.black);
  151.       TextMode (srcOr);
  152.     }
  153.   }
  154.   return Atom(0);
  155. }
  156.  
  157. value plot(x, y)    /* ML */
  158.     value x, y;
  159. {
  160.     short h, v;
  161.     Point old_pen_size;
  162.     
  163.     check_graph();
  164.     h = Short_val(x);
  165.     v = convert_y(y);
  166.     SetPort(CAMLOffScreen);
  167.     old_pen_size = CAMLOffScreen->pnSize;
  168.     PenSize (1, 1);
  169.     MoveTo(h, v);
  170.     LineTo(h, v);
  171.     PenSize (old_pen_size.h, old_pen_size.v);
  172.     SetPort(CAMLGraph);
  173.     ClipRect(&grafpk->viewRect);
  174.     h += offset_x;
  175.     v += offset_y;
  176.     PenSize (1, 1);
  177.     MoveTo(h, v);
  178.     LineTo(h, v);
  179.     PenSize (old_pen_size.h, old_pen_size.v);
  180.     ClipRect(&CAMLGraph->portRect);
  181.     return Atom(0);
  182. }
  183.  
  184. value point_color(x, y)    /* ML */
  185.     value x, y;
  186. {
  187.     Point p;
  188.     
  189.     check_graph();
  190.     SetPt(&p, Short_val(x), convert_y(y));
  191.     if (!PtInRect(p, &CAMLOffScreen->portRect))
  192.         graphic_fail("point_color: point out of graphic window");
  193.     if (color_qd){
  194.       RGBColor qd_col;
  195.       Begin_offscreen
  196.         GetCPixel (p.h, p.v, &qd_col);
  197.       End_offscreen
  198.       return Val_long ((qd_col.red / 256 << 16)
  199.                        + (qd_col.green / 256 << 8)
  200.                        + (qd_col.blue / 256));
  201.         }else{
  202.       SetPort(CAMLOffScreen);
  203.       return GetPixel(p.h, p.v) ? Val_long(0) : Val_long(0xFFFFFF);
  204.     }
  205. }
  206.  
  207. value moveto(x, y)    /* ML */
  208.     value x, y;
  209. {
  210.     check_graph();
  211.     SetPort(CAMLOffScreen);
  212.     MoveTo(Short_val(x), convert_y(y));
  213.     return Atom(0);
  214. }
  215.  
  216. value current_point()    /* ML */
  217. {
  218.     value res;
  219.     Point p;
  220.     
  221.     check_graph();
  222.     SetPort(CAMLOffScreen);
  223.     GetPen(&p);
  224.     res = alloc_tuple(2);
  225.     Field(res, 0) = Val_long(p.h);
  226.     Field(res, 1) = Val_long(convert_y(Val_long(p.v)));
  227.     return res;
  228. }
  229.  
  230. value lineto(x, y)    /* ML */
  231.     value x, y;
  232. {
  233.     short h, v;
  234.     Point p;
  235.     
  236.     check_graph();
  237.     SetPort(CAMLOffScreen);
  238.     GetPen(&p);
  239.     h = Short_val(x);
  240.     v = convert_y(y);
  241.     LineTo(h, v);
  242.     SetPort(CAMLGraph);
  243.     ClipRect(&grafpk->viewRect);
  244.     MoveTo(p.h + offset_x, p.v + offset_y);
  245.     LineTo(h + offset_x, v + offset_y);
  246.     ClipRect(&CAMLGraph->portRect);
  247.     return Atom(0);
  248. }
  249.  
  250. value draw_arc(argv, argn)    /* ML */
  251.     value * argv;
  252.     int argn;
  253. {
  254. #pragma unused(argn)
  255.     short h, v, r_x, r_y, start, arc;
  256.     Rect r;
  257.     
  258.     check_graph();
  259.     r_x = Short_val(argv[2]);
  260.     r_y = Short_val(argv[3]);
  261.     if ((r_x < 0) || (r_y < 0))
  262.         graphic_fail("draw_arc: radius must be positives");
  263.     h = Short_val(argv[0]);
  264.     v = convert_y(argv[1]);
  265.     SetRect(&r, h - r_x, v - r_y, h + r_x + 1, v + r_y + 1);
  266.     SetPort(CAMLOffScreen);
  267.     start = Short_val(argv[4]);
  268.     arc = Short_val(argv[5]) - start;
  269.     while (arc < 0)
  270.         arc += 360;
  271.     FrameArc(&r, 90 - start, -arc);
  272.     SetPort(CAMLGraph);
  273.     ClipRect(&grafpk->viewRect);
  274.     OffsetRect(&r, offset_x, offset_y);
  275.     FrameArc(&r, 90 - start, -arc);
  276.     ClipRect(&CAMLGraph->portRect);
  277.     return Atom(0);
  278. }
  279.  
  280. value set_line_width(width)    /* ML */
  281.     value width;
  282. {
  283.     short size;
  284.     
  285.     check_graph();
  286.     size = Short_val(width);
  287.     if (size < 0)
  288.         graphic_fail("set_line_width: width must be positive");
  289.     SetPort(CAMLOffScreen);
  290.     PenSize(size, size);
  291.     SetPort(CAMLGraph);
  292.     PenSize(size, size);
  293.     return Atom(0);
  294. }
  295.  
  296. value draw_char(ch)    /* ML */
  297.     value ch;
  298. {
  299.     Point p;
  300.     
  301.     check_graph();
  302.     Begin_offscreen
  303.       GetPen(&p);
  304.       DrawChar((char) Long_val(ch));
  305.     End_offscreen
  306.     SetPort(CAMLGraph);
  307.     ClipRect(&grafpk->viewRect);
  308.     MoveTo(p.h + offset_x, p.v + offset_y);
  309.     DrawChar((char) Long_val(ch));
  310.     ClipRect(&CAMLGraph->portRect);
  311.     return Atom(0);
  312. }
  313.  
  314. value draw_string(str)    /* ML */
  315.     value str;
  316. {
  317.     mlsize_t len;
  318.     Point p;
  319.     
  320.     check_graph();
  321.     if ((len = string_length(str)) > 32767)
  322.         len = 32767;
  323.     Begin_offscreen
  324.       GetPen(&p);
  325.       DrawText(Bp_val(str), 0, (unsigned short) len);
  326.     End_offscreen
  327.     SetPort(CAMLGraph);
  328.     ClipRect(&grafpk->viewRect);
  329.     MoveTo(p.h + offset_x, p.v + offset_y);
  330.     DrawText(Bp_val(str), 0, (short) len);
  331.     ClipRect(&CAMLGraph->portRect);
  332.     return Atom(0);
  333. }
  334.  
  335. value set_font(str)    /* ML */
  336.     value str;
  337. {
  338.     Str255 name;
  339.     short i, len, fontnum;
  340.     
  341.     check_graph();
  342.     len = string_length(str);
  343.     for(i = 0; (i < len) && (i < 255); i++)
  344.         name[i + 1] = Byte(str, i);
  345.     name[0] = i;
  346.     GetFNum(name,&fontnum);
  347.     SetPort(CAMLOffScreen);
  348.     TextFont(fontnum);
  349.     SetPort(CAMLGraph);
  350.     TextFont(fontnum);
  351.     return Atom(0);
  352. }
  353.  
  354. value set_text_size(size)    /* ML */
  355.     value size;
  356. {
  357.     short s;
  358.     
  359.     check_graph();
  360.     SetPort(CAMLOffScreen);
  361.     s = Short_val(size);
  362.     if (s < 0)
  363.         graphic_fail("set_text_size: size must be positive");
  364.     TextSize(s);
  365.     SetPort(CAMLGraph);
  366.     TextSize(s);
  367.     return Atom(0);
  368. }
  369.  
  370. value text_size(str)    /* ML */
  371.     value str;
  372. {
  373.     value res;
  374.     FontInfo info;
  375.     
  376.     check_graph();
  377.     SetPort(CAMLOffScreen);
  378.     GetFontInfo(&info);
  379.     res = alloc_tuple(2);
  380.     Field(res, 0) = Val_long(TextWidth(Bp_val(str), 0, string_length(str)));
  381.     Field(res, 1) = Val_long(info.ascent + info.descent);
  382.     return res;
  383. }
  384.  
  385. value fill_rect(x, y, wdth, hgth)    /* ML */
  386.     value x, y, wdth, hgth;
  387. {
  388.     short h, v, width, heigth;
  389.     Rect r;
  390.     
  391.     check_graph();
  392.     width = Short_val(wdth);
  393.     heigth = Short_val(hgth);
  394.     if ((width < 0) || (heigth < 0))
  395.         graphic_fail("fill_rect: width and heigth must be positives");
  396.     h = Short_val(x);
  397.     v = convert_y(y) + 1;
  398.     SetRect(&r, h, v - heigth, h + width, v);
  399.     SetPort(CAMLOffScreen);
  400.     PaintRect(&r);
  401.     SetPort(CAMLGraph);
  402.     ClipRect(&grafpk->viewRect);
  403.     OffsetRect(&r, offset_x, offset_y);
  404.     PaintRect(&r);
  405.     ClipRect(&CAMLGraph->portRect);
  406.     return Atom(0);
  407. }
  408.  
  409. value fill_arc(argv, argn)    /* ML */
  410.     value * argv;
  411.     int argn;
  412. {
  413. #pragma unused(argn)
  414.     short h, v, r_x, r_y, start, arc;
  415.     Rect r;
  416.     
  417.     check_graph();
  418.     r_x = Short_val(argv[2]);
  419.     r_y = Short_val(argv[3]);
  420.     if ((r_x < 0) || (r_y < 0))
  421.         graphic_fail("draw_arc: radius must be positives");
  422.     h = Short_val(argv[0]);
  423.     v = convert_y(argv[1]);
  424.     SetRect(&r, h - r_x, v - r_y, h + r_x + 1, v + r_y + 1);
  425.     start = Short_val(argv[4]);
  426.     arc = Short_val(argv[5]) - start;
  427.     while (arc < 0)
  428.         arc += 360;
  429.     SetPort(CAMLOffScreen);
  430.     PaintArc(&r, 90 - start, -arc);
  431.     SetPort(CAMLGraph);
  432.     ClipRect(&grafpk->viewRect);
  433.     OffsetRect(&r, offset_x, offset_y);
  434.     PaintArc(&r, 90 - start, -arc);
  435.     ClipRect(&CAMLGraph->portRect);
  436.     return Atom(0);
  437. }
  438.  
  439. value fill_poly(vect)    /* ML */
  440.     value vect;
  441. {
  442.     int n_points, i;
  443.     PolyHandle poly;
  444.     
  445.     check_graph();
  446.     n_points = Wosize_val(vect);
  447.     if (n_points < 3)
  448.         graphic_fail("fill_poly: not enough points");
  449.     SetPort(CAMLOffScreen);
  450.     poly = OpenPoly();
  451.     MoveTo(Short_val(Field(Field(vect, 0), 0)), convert_y(Field(Field(vect, 0), 1)));
  452.     for(i = 1; i < n_points; i++)
  453.         LineTo(Short_val(Field(Field(vect, i), 0)), convert_y(Field(Field(vect, i), 1)));
  454.     LineTo(Short_val(Field(Field(vect, 0), 0)), convert_y(Field(Field(vect, 0), 1)));
  455.     ClosePoly();
  456.     PaintPoly(poly);
  457.     SetPort(CAMLGraph);
  458.     ClipRect(&grafpk->viewRect);
  459.     OffsetPoly(poly, offset_x, offset_y);
  460.     PaintPoly(poly);
  461.     ClipRect(&CAMLGraph->portRect);
  462.     KillPoly(poly);
  463.     return Atom(0);
  464. }
  465.  
  466. struct image {
  467.   value w;
  468.   value h;
  469.   value data;
  470.   value mask;
  471. };
  472.  
  473. #define Width(i) (((struct image *) i)->w)
  474. #define Height(i) (((struct image *) i)->h)
  475. #define Data(i) (((struct image *) i)->data)
  476. #define Mask(i) (((struct image *) i)->mask)
  477.  
  478. static value new_bits(width, height, depth)
  479.     int width, height;
  480. {
  481.   int rowbytes, nbytes, nwords;
  482.   value res;
  483.  
  484.   rowbytes = (depth * width + 31) / 32 * 4;
  485.   nbytes = rowbytes * height;
  486.   nwords = (nbytes + 3) / 4;
  487.   if (nwords == 0) return Atom (Abstract_tag);
  488.   if (nwords <= Max_young_wosize) {
  489.     res = alloc(nwords, Abstract_tag);
  490.   }else{
  491.     res = alloc_shr(nwords, Abstract_tag);
  492.   }
  493.   return res;
  494. }
  495.  
  496. static BitMap **image_to_bitmap (image, w, h, is_mask)
  497.     value image;
  498. {
  499.   if (color_qd && !is_mask){
  500.     GDHandle old_device;
  501.     PixMapHandle result;
  502.     
  503.     old_device = GetGDevice ();
  504.     SetGDevice (CAMLGDevice);
  505.     result = NewPixMap ();
  506.     DisposHandle ((Handle) (*result)->pmTable);
  507.     (*result)->pmTable = (*((CGrafPtr) CAMLOffScreen)->portPixMap)->pmTable;
  508.     (*result)->baseAddr = (Ptr) image;
  509.     (*result)->rowBytes = (max_depth * w + 31) / 32 * 4 + 0x8000;
  510.     SetRect (&(*result)->bounds, 0, 0, w, h);
  511.     SetGDevice (old_device);
  512.     return (BitMap **) result;
  513.   }else{
  514.     BitMap **result = (BitMap **) NewHandle (sizeof (BitMap));
  515.  
  516.     (*result)->baseAddr = (Ptr) image;
  517.     (*result)->rowBytes = (w + 31) / 32 * 4;
  518.     SetRect(&(*result)->bounds, 0, 0, w, h);
  519.     return result;
  520.   }
  521. }
  522.  
  523. value make_image (value mat)    /* ML */
  524. {
  525.   int height, width, i, j;
  526.   int has_transp;
  527.   GrafPtr old_port;
  528.   value res;
  529.   Push_roots(roots, 3)
  530. #define bdata (roots[0])
  531. #define bmask (roots[1])
  532. #define matrix (roots[2])
  533.   
  534.   check_graph ();
  535.   matrix = mat;
  536.   GetPort (&old_port);
  537.   height = Wosize_val(matrix);
  538.   if (height == 0) {
  539.     width = 0;
  540.   } else {
  541.     width = Wosize_val(Field(matrix, 0));
  542.     for (i = 1; i < height; i++) {
  543.       if (width != Wosize_val(Field(matrix, i)))
  544.     graphic_fail("make_image: non-rectangular matrix");
  545.     }
  546.   }
  547.   bdata = new_bits (width, height, max_depth);
  548.   has_transp = 0;
  549.   if (color_qd){
  550.     CGrafPort port;
  551.     RGBColor qd_col;
  552.     long col;
  553.     
  554.     OpenCPort (&port);
  555.     DisposHandle ((Handle) port.portPixMap);
  556.     port.portPixMap = (PixMapHandle) image_to_bitmap (bdata, width, height, 0);
  557.     port.portRect = (*port.portPixMap)->bounds;
  558.     for (i = 0; i< height; i++){
  559.       for (j = 0; j < width; j++){
  560.         col = Long_val (Field (Field (matrix, i), j));
  561.     if (col == -1){
  562.       has_transp = 1;
  563.     }else{
  564.       qd_col.red = (col >> 16) * 256;
  565.       qd_col.green = ((col >> 8) & 0xff) * 256;
  566.       qd_col.blue = (col & 0xff) * 256;
  567.           SetCPixel (j, i, &qd_col);
  568.     }
  569.       }
  570.     }
  571.     SetPort (old_port);
  572.     CloseCPort (&port);
  573.   }else{
  574.     GrafPort port;
  575.     BitMap **h;
  576.     
  577.     OpenPort (&port);
  578.     h = image_to_bitmap (bdata, width, height, 0);
  579.     port.portBits = **h;
  580.     DisposHandle ((Handle) h);
  581.     port.portRect = port.portBits.bounds;
  582.     EraseRect (&port.portBits.bounds);
  583.     for (i = 0; i< height; i++){
  584.       for (j = 0; j < width; j++){
  585.         switch (Long_val (Field (Field (matrix, i), j))){
  586.     case -1: has_transp = 1; break;
  587.     case 0xFFFFFF: break;
  588.     default: MoveTo (j, i); Line (0, 0); break;
  589.     }
  590.       }
  591.     }
  592.     SetPort (old_port);
  593.     ClosePort (&port);
  594.   }
  595.   if (has_transp) {
  596.     GrafPort port;
  597.     BitMap **h;
  598.  
  599.     bmask = new_bits (width, height, 1);
  600.     OpenPort (&port);
  601.     h = image_to_bitmap (bmask, width, height, 1);
  602.     port.portBits = **h;
  603.     DisposHandle ((Handle) h);
  604.     port.portRect = port.portBits.bounds;
  605.     EraseRect (&port.portBits.bounds);
  606.     for (i = 0; i< height; i++){
  607.       for (j = 0; j < width; j++){
  608.         if (Long_val (Field (Field (matrix, i), j)) != -1){
  609.       MoveTo (j, i); Line (0, 0);
  610.     }
  611.       }
  612.     }
  613.     SetPort (old_port);
  614.     ClosePort (&port);
  615.   }else{
  616.     bmask = Val_long (0);
  617.   }
  618.   res = alloc_tuple (4);
  619.   Width (res) = Val_int (width);
  620.   Height (res) = Val_int (height);
  621.   Data (res) = bdata;
  622.   Mask (res) = bmask;
  623.   Pop_roots ();
  624.   return res;
  625. #undef matrix
  626. #undef bdata
  627. #undef bmask
  628. }
  629.  
  630. static value alloc_int_vect(size)
  631.     mlsize_t size;
  632. {
  633.     value res;
  634.     mlsize_t i;
  635.     
  636.     if (size == 0) return Atom(0);
  637.     if (size <= Max_young_wosize) {
  638.         res = alloc(size, 0);
  639.     } else {
  640.         res = alloc_shr(size, 0);
  641.     }
  642.     for (i = 0; i < size; i++) {
  643.         Field(res, i) = Val_long(0);
  644.     }
  645.     return res;
  646. }
  647.     
  648. value dump_image(value image)    /* ML */
  649. {
  650.   int height, width, i, j;
  651.   GrafPtr old_port;
  652.   Push_roots(roots, 2);
  653. #define matrix (roots[0])
  654. #define im (roots [1])
  655.  
  656.   check_graph ();
  657.   im = image;
  658.   GetPort (&old_port);
  659.   height = Int_val (Height (im));
  660.   width = Int_val (Width (im));
  661.   matrix = alloc_int_vect (height);
  662.   for (i = 0; i < height; i++) {
  663.     modify (&Field (matrix, i), alloc_int_vect (width));
  664.   }
  665.  
  666.   if (color_qd){
  667.     CGrafPort port;
  668.     RGBColor qd_col;
  669.      
  670.     OpenCPort (&port);
  671.     DisposHandle ((Handle) port.portPixMap);
  672.     port.portPixMap
  673.       = (PixMapHandle) image_to_bitmap (Data (im), width, height, 0);
  674.     port.portRect = (*port.portPixMap)->bounds;
  675.     for (i = 0; i< height; i++){
  676.       for (j = 0; j < width; j++){
  677.         GetCPixel (j, i, &qd_col);
  678.     Field (Field (matrix, i), j) = Val_long ((qd_col.red / 256 << 16)
  679.                                              + (qd_col.green / 256 << 8)
  680.                          + qd_col.blue / 256);
  681.       }
  682.     }
  683.     SetPort (old_port);
  684.     CloseCPort (&port);
  685.   }else{
  686.     GrafPort port;
  687.     BitMap **h;
  688.     
  689.     OpenPort (&port);
  690.     h = image_to_bitmap (Data (im), width, height, 0);
  691.     port.portBits = **h;
  692.     DisposHandle ((Handle) h);
  693.     port.portRect = port.portBits.bounds;
  694.     for (i = 0; i< height; i++){
  695.       for (j = 0; j < width; j++){
  696.         Field (Field (matrix, i), j)
  697.       = Val_long (GetPixel (j, i) ? 0 : 0xFFFFFF);
  698.       }
  699.     }
  700.     SetPort (old_port);
  701.     ClosePort (&port);
  702.   }
  703.  
  704.   if (Mask(im) != Val_long(0)) {
  705.     GrafPort port;
  706.     BitMap **h;
  707.     
  708.     OpenPort (&port);
  709.     h = image_to_bitmap (Mask (im), width, height, 1);
  710.     port.portBits = **h;
  711.     DisposHandle ((Handle) h);
  712.     port.portRect = port.portBits.bounds;
  713.     for (i = 0; i< height; i++){
  714.       for (j = 0; j < width; j++){
  715.         if (! GetPixel (j, i)) Field (Field (matrix, i), j) = -1;
  716.       }
  717.     }
  718.     SetPort (old_port);
  719.     ClosePort (&port);
  720.   }
  721.   Pop_roots();
  722.   return matrix;
  723. #undef matrix
  724. #undef im
  725. }
  726.  
  727. value draw_image(image, x, y)    /* ML */
  728.     value image, x, y;
  729. {
  730.   short rx, ry;
  731.   int w, h;
  732.   BitMap **src_bitmap, **mask_bitmap;
  733.   Rect dst_rect, src_rect;
  734.   
  735.   check_graph();
  736.   w = Int_val (Width (image));
  737.   h = Int_val (Height (image));
  738.   rx = Long_val(x);
  739.   ry = convert_y(y) - h + 1;
  740.   SetRect (&dst_rect, rx, ry, rx + w, ry + h);
  741.   SetRect (&src_rect, 0, 0, w, h);
  742.   Begin_offscreen
  743.     if (Mask (image) != Val_long(0)) {
  744.       src_bitmap = image_to_bitmap (Data(image), w, h, 0);
  745.       mask_bitmap = image_to_bitmap (Mask(image), w, h, 1);
  746.       copy_mask (*src_bitmap, *mask_bitmap, &CAMLOffScreen->portBits,
  747.              &src_rect, &src_rect, &dst_rect);
  748.       DisposHandle ((Handle) src_bitmap);
  749.       DisposHandle ((Handle) mask_bitmap);
  750.     }else{
  751.       src_bitmap = image_to_bitmap (Data(image), w, h, 0);
  752.       copy_bits (*src_bitmap, &CAMLOffScreen->portBits,
  753.                  &src_rect, &dst_rect, srcCopy, nil);
  754.       DisposHandle ((Handle) src_bitmap);
  755.     }
  756.   End_offscreen
  757.   OffsetRect(&dst_rect, offset_x, offset_y);
  758.   SectRect(&dst_rect, &grafpk->viewRect, &dst_rect);
  759.   src_rect = dst_rect;
  760.   OffsetRect(&src_rect, -offset_x, -offset_y);
  761.   SetPort (CAMLGraph);
  762.   copy_bits (&CAMLOffScreen->portBits, &CAMLGraph->portBits,
  763.          &src_rect, &dst_rect, srcCopy, nil);
  764.   return Atom(0);
  765. }
  766.  
  767. value create_image (value w, value h)     /* ML */
  768. {
  769.   value res;
  770.   Push_roots (roots, 1);
  771. #define bdata (roots[0])
  772.  
  773.   check_graph ();
  774.   if (Int_val (w) < 0 || Int_val (h) < 0)
  775.     graphic_fail("get_image: width and height must be positive");
  776.   bdata = new_bits (Int_val (w), Int_val (h), max_depth);
  777.   res = alloc_tuple (4);
  778.   Width (res) = w;
  779.   Height (res) = h;
  780.   Data (res) = bdata;
  781.   Mask (res) = Val_long (0);
  782.   Pop_roots ();
  783.   return res;
  784. #undef bdata
  785. }
  786.  
  787. value blit_image (value i, value x, value y)    /* ML */
  788. {
  789.   short rx, ry, width, height;
  790.   BitMap **dst_bitmap;
  791.   Rect src_rect;
  792.   
  793.   check_graph();
  794.   width = Short_val (Width (i));
  795.   height = Short_val (Height (i));
  796.   dst_bitmap = image_to_bitmap (Data (i), width, height, 0);
  797.   rx = Short_val(x);
  798.   ry = convert_y(y) + 1;
  799.   SetRect (&src_rect, rx, ry - height, rx + width, ry);
  800.   Begin_offscreen
  801.   copy_bits (&CAMLOffScreen->portBits, *dst_bitmap,
  802.              &src_rect, &(*dst_bitmap)->bounds, srcCopy, nil);
  803.   End_offscreen
  804.   return Atom (0);
  805. }
  806.  
  807. value wait_event (value l)        /* ML */
  808. {
  809.   int b_down = 0;
  810.   int b_up = 0;
  811.   int key_press = 0;
  812.   int motion = 0;
  813.   int poll = 0;
  814.   EventRecord event;
  815.   value result;
  816.  
  817.   check_graph ();
  818.   enter_blocking_section ();
  819.   while (l != Atom (0)){
  820.     switch (Tag_val (Field (l, 0))){
  821.     case 0: b_down = 1; break;
  822.     case 1: b_up = 1; break;
  823.     case 2: key_press = 1; break;
  824.     case 3: motion = 1; break;
  825.     case 4: poll = 1; break;
  826.     }
  827.     l = Field (l, 1);
  828.   }
  829.   while (1){
  830.     LookGraphEvent (&event, motion, poll);
  831.     if (poll || motion
  832.         || b_down && event.what == mouseDown
  833.         || b_up && event.what == mouseUp
  834.     || key_press && event.what == keyDown)
  835.       break;
  836.   }
  837.   result = alloc_tuple (5);
  838.   SetPort (CAMLGraph);
  839.   GlobalToLocal (&event.where);
  840.   Field (result, 0) = Val_int (event.where.h - offset_x);
  841.   Field (result, 1) = Val_int (CAMLOffScreen->portRect.bottom - 1
  842.                                - (event.where.v - offset_y));
  843.   Field (result, 2) = Atom (!(event.modifiers & btnState));
  844.   if (event.what == keyDown){
  845.     Field (result, 3) = Atom (1);
  846.     Field (result, 4) = Val_int (event.message & charCodeMask);
  847.   }else{
  848.     Field (result, 3) = Atom (0);
  849.     Field (result, 4) = Val_int (0);
  850.   }
  851.   leave_blocking_section ();
  852.   return result;
  853. }
  854.  
  855. value sound(freq, delay)    /* ML */
  856.     value freq, delay;
  857. {
  858.   long f = Long_val (freq);
  859.   long d = Long_val (delay);
  860.   int note;
  861.   SndCommand cmd;
  862.   SndChannelPtr chan = NULL;
  863.   
  864.   enter_blocking_section();
  865.   note = 69 + (log((double) f / 440.0) / log(twelfthRootTwo) + 0.5);
  866.   if (note < 1) note = 1;
  867.   if (note > 127) note = 127;
  868.   cmd.cmd = freqDurationCmd;
  869.   cmd.param1 = d * 2;
  870.   cmd.param2 = 0xFF000000 + note;
  871.   if (SndNewChannel (&chan, squareWaveSynth, 0, NULL) != noErr){
  872.     SysBeep (1);
  873.   }else{
  874.     if (SndDoCommand (chan, &cmd, 0) != noErr) SysBeep(1);
  875.     SndDisposeChannel (chan, 0);
  876.   }
  877.   leave_blocking_section();
  878.   return Atom(0);
  879. }
  880.